Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue27/tiptrix/Dbrestr/RestrU.PAS

Pascal/Delphi Source File | 1997-07-15 | 5.3 KB | 209 lines

unit Restru;
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Buttons, ExtCtrls, Menus, StdCtrls, DbTables, MainU;

type
  TRestrF = class(TForm)
    ListBox1: TListBox;
    MainMenu1: TMainMenu;
    Field1: TMenuItem;
    Add1: TMenuItem;
    Insert1: TMenuItem;
    Rename1: TMenuItem;
    Delete1: TMenuItem;
    N1: TMenuItem;
    Close1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure MenuClick(Sender: TObject);
    procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure Close1Click(Sender: TObject);
  private
    Ind : ShortInt;
    IsDragging : boolean;
  public
    procedure Modify(ATable: TTable);
  end;

var
  RestrF: TRestrF;

implementation
uses
  DB,DBRestr,AddU,{$IFDEF Win32} Bde {$ELSE} DbiTypes {$ENDIF};
{$R *.DFM}

procedure TRestrF.FormCreate(Sender: TObject);
begin
  AutoScroll := True;
end;

procedure TRestrF.Modify(ATable: TTable);
var
  j: byte;
begin
  ListBox1.Clear;
  with ATable do
    for j:=0 to FieldCount-1 do
      ListBox1.Items.Add(Fields[j].FieldName);
  ShowModal;
end;

procedure TRestrF.MenuClick(Sender: TObject);
const
  FieldTypes : array[0..1] of TFieldType = (ftString,ftInteger);
  FieldSizes : array[0..1] of byte = (30,0);
var
  j,ATag,ComboInd: byte;
  S, OldName: string;
begin
 Atag := (Sender as TMenuItem).Tag;
 if ATag <> 0 then begin
   Ind:= ListBox1.ItemIndex;
   if Ind = -1 then begin
     MessageDlg('No item selected!',mtError,[mbOk],0);
     exit;
   end;
 end;
 MainF.Table1.DisableControls;
 try try
  case ATag of
    0,1 :
      begin
        AddF := TAddF.Create(Application);
        with AddF do try
          if ATag=0 then
            Caption :='Add Field'
          else
            Caption := 'Insert Field';
          Edit1.Text := '';
          ComboBox1.ItemIndex := 0;
          if ShowModal <> mrOk then exit;
          ComboInd := ComboBox1.ItemIndex;
          S:=Edit1.Text;
          if S = '' then exit;
          if ATag = 0 then
            Restructure(MainF.Table1, resADD, MainF.Table1.FieldCount,0,
              S,FieldTypes[ComboInd],FieldSizes[ComboInd])
          else
            Restructure(MainF.Table1, resADD, Ind,0,
              S,FieldTypes[ComboInd],FieldSizes[ComboInd]);
        finally
          AddF.Free;
        end;
     end;

     2 :
       begin
         with ListBox1 do
           OldName := Items[ItemIndex];
         AddF := TAddF.Create(Application);
         with AddF do try
           Caption := 'Rename Field';
           Edit1.Text := OldName;
           if ShowModal <> mrOk then exit;
           S:=Edit1.Text;
           if (S='') or(S = OldName) then exit;
           Restructure(MainF.Table1, resModify, Ind,0,
             S,ftUnknown,0);
         finally
           AddF.Free;
         end;
       end;

     3 :
       if MessageDlg('Delete this field?',mtWarning,
         [mbYes,mbNo],0) = mrYes then
           Restructure(MainF.Table1, resDROP, Ind,0,
             '',ftUnknown,0);

  end;
  with ListBox1.Items do begin
    BeginUpdate;
    Clear;
    for j:=0 to MainF.Table1.FieldCount-1 do
      ListBox1.Items.Add(MainF.Table1.Fields[j].FieldName);
    EndUpdate;
  end;
 except
  MessageDlg('Unable to perform operation.',mtError,
    [mbOk],0);
 end;
 finally
   MainF.Table1.EnableControls;
 end;
end;

procedure TRestrF.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := (Source = ListBox1);
end;

procedure TRestrF.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button <> mbLeft) or (IsDragging) then exit;
  Ind := ListBox1.ItemIndex;
  if Ind <> -1 then ListBox1.BeginDrag(False);
end;


procedure TRestrF.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  Dest : ShortInt;
  j: byte;
begin
  with ListBox1 do begin
    IsDragging := true;
    Perform(wm_LButtonDown, 0, MakeLong(X, Y));
    Perform(wm_LButtonUp,   0, MakeLong(X, Y));
    Dest := ItemIndex;
    if (Dest <> -1) and (Dest <> Ind) then begin
      MainF.Table1.DisableControls;
      try try
        Restructure(MainF.Table1, resMOVE, Ind,Dest,
           '',ftUnknown,0);
        with Items do begin
          BeginUpdate;
          Clear;
          for j:=0 to MainF.Table1.FieldCount-1 do
            Add(MainF.Table1.Fields[j].FieldName);
          EndUpdate;
        end;
      except
        MessageDlg('Unable to perform operation.',mtError,
            [mbOk],0);
      end;
      finally
        MainF.Table1.EnableControls;
      end;
    end;
  end;
end;

procedure TRestrF.ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  IsDragging := false;
end;

procedure TRestrF.FormShow(Sender: TObject);
begin
  IsDragging := false;
end;

procedure TRestrF.Close1Click(Sender: TObject);
begin
  Close;
end;

end.